home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Src / irun.h < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-02  |  15.3 KB  |  572 lines
  1. /* A few typedefs to get things started */
  2. #define MACHINE_BSD 1
  3.  
  4. #include <runtime.h>
  5.  
  6. #ifdef __STDC__
  7.  
  8. extern LispObject Slowcall(LispObject*);
  9. extern LispObject elvira_slowcall_object;
  10.  
  11. typedef LispObject (LispFN)(LispObject*);
  12. /* really now gratuitous documentation... */
  13. typedef LispObject (LispFN0)(LispObject*);
  14. typedef LispObject (LispFN1)(LispObject*);
  15. typedef LispObject (LispFN2)(LispObject*);
  16. typedef LispObject (LispFN3)(LispObject*);
  17. typedef LispObject (LispFN4)(LispObject*);
  18. typedef LispObject (LispFN5)(LispObject*);
  19.  
  20. /* Stack Organisation
  21.  
  22. ------------------------------------------------------
  23. | ARG1 ... ARGn | DISPLAY | LOCAL1 ... LOCALn | 
  24. ------------------------------------------------------
  25. ^               ^                             ^
  26. argptr          localptr                      callbase
  27.  
  28. */
  29.  
  30. /*  argument access */
  31. #define arg(n) argptr[(n)-1]
  32. #define a1 argptr[0]
  33. #define a2 argptr[1]
  34. #define a3 argptr[2]
  35. #define a4 argptr[3]
  36. #define a5 argptr[4]
  37. #define a6 argptr[5]
  38. #define a7 argptr[6]
  39. #define a8 argptr[7]
  40. #define a9 argptr[8]
  41. #define a10 argptr[9]
  42.  
  43. /* alias iregs to aregs */
  44. #define i1 a1
  45. #define i2 a2
  46. #define i3 a3
  47. #define i4 a4
  48. #define i5 a5
  49. #define i6 a6
  50. #define i7 a7
  51. #define i8 a8
  52. #define i9 a9
  53. #define i10 a10
  54.  
  55. /* access to display save slot */
  56. #define SAVE_DISPLAY localptr[0] = dp;
  57. #define RESTORE_DISPLAY dlp = dp = localptr[0];
  58.  
  59. /* access to compiler temporaries */
  60. #define local(n) localptr[n+1]
  61.  
  62. #define l0 localptr[1]
  63. #define l1 localptr[2]
  64. #define l2 localptr[3]
  65. #define l3 localptr[4]
  66. #define l4 localptr[5]
  67. #define l5 localptr[6]
  68. #define l6 localptr[7]
  69. #define l7 localptr[8]
  70. #define l8 localptr[9]
  71. #define l9 localptr[10]
  72. #define l10 localptr[11]
  73. #define l11 localptr[12]
  74. #define l12 localptr[13]
  75. #define l13 localptr[14]
  76. #define l14 localptr[15]
  77. #define l15 localptr[16]
  78. #define l16 localptr[17]
  79. #define l17 localptr[18]
  80. #define l18 localptr[19]
  81. #define l19 localptr[20]
  82. #define l20 localptr[21]
  83.  
  84. #define callarg(n) (*(callbase+(n-1)))
  85.  
  86. /* creation, deletion and access to run-time temporaries */
  87. #define MAKE_TEMP(value) \
  88.   PUSH(value); \
  89.   callbase++;
  90.  
  91. #define UNMAKE_TEMP callbase--
  92.  
  93. #define TEMP(n) callbase[-n]
  94.  
  95. /* basic stack manipulation */
  96.  
  97. #define PUSH(x) (topptr[0] = x, ++topptr)
  98. #define POP(x) (topptr-- , x = topptr[0])
  99. /* tacky hack */
  100. #define POPVAL() (topptr--, topptr[0])
  101. #define o1 POPVAL()
  102. /* --- Function linkage --- */
  103.  
  104. #define CALL(mod,offset,nargs) \
  105. { \
  106.   SAVE_DISPLAY; \
  107.   dlp = dp = nil; \
  108.   topptr=callbase; \
  109.   PUSH( \
  110.      ((*((LispFN/**/nargs *)Module_/**/mod.functions[offset])) == NULL ? \
  111.       elvira_slowcall_object = Module_/**/mod.values[offset], \
  112.       (LispFN/**/nargs *)Slowcall : \
  113.       (*((LispFN/**/nargs *)Module_/**/mod.functions[offset])))(callbase)); \
  114.   RESTORE_DISPLAY; \
  115. }
  116.  
  117. #define FastLCALL(fn,nargs) \
  118. { \
  119.   SAVE_DISPLAY; \
  120.   dlp = dp = nil; \
  121.   topptr=callbase;\
  122.   PUSH(fn(callbase)); \
  123.   RESTORE_DISPLAY; \
  124. }
  125.  
  126. #define PSEUDORET(result) \
  127.   (*callbase = (result),topptr=callbase+1)
  128. /* --- dynamic extent continuations --- */
  129.  
  130. #define BEGIN_W_CC \
  131.   while (1) \
  132.     { \
  133.     callbase[0] = (allocate_continue(callbase)); \
  134.     callbase[1] = callbase[0]; \
  135. printf("cbase: %x dp1: %x\n", callbase, dp); \
  136.     callbase++; topptr=callbase+1;\
  137.     transfer_display_to_heap(callbase); \
  138.     if (set_continue(callbase,callbase[-1])) { \
  139.        topptr=callbase;\
  140.        callbase+= -1; \
  141.        RESTORE_DISPLAY;\
  142. printf("cbase: dp2: %x\n", callbase, dp);\
  143.        if (typeof(callbase[0])!=TYPE_CONTINUE) \
  144.      exit(0); \
  145.        callbase[0] = (callbase[0])->CONTINUE.value; \
  146.        break; \
  147.     };
  148.  
  149.         
  150. /* THIS IS BROKEN FOR THE PRESENT... */
  151.  
  152. #define END_W_CC \
  153.   topptr = callbase; callbase+= -1;  \
  154.   unset_continue(callbase[0]); \
  155.   callbase[0] = callbase[1]; \
  156. printf("dp3: %x\n", dp); \
  157.   break; \
  158. }
  159.  
  160. #define SLIDE(n)  /* Move 'n' args down the stack to argbase */ \
  161.           {                    \
  162.         int i;                \
  163.         for (i=0; i< n ; i++)        \
  164.           arg(i+1)=callarg(i+1);        \
  165.             \
  166.           }                    
  167.  
  168. /* --- with-handler --- */
  169.  
  170. #define BEGIN_W_H \
  171.   callarg(2)=(HANDLER_STACK()); \
  172.   HANDLER_STACK() = Fn_cons(callbase); \
  173.   topptr = callbase+1;
  174.  
  175. #define END_W_H \
  176.   HANDLER_STACK() = CDR(HANDLER_STACK())
  177.  
  178. /* --- unwind-protect --- */
  179.  
  180. #define BEGIN_U_P \
  181. { \
  182.         LispObject unwind_cont,cleanup;\
  183. \
  184.             cleanup = *callbase; \
  185.             unwind_cont = allocate_continue(callbase); \
  186.         *(callbase+1) = unwind_cont; \
  187.         callbase +=2; \
  188.           \
  189.             if (set_continue(callbase,unwind_cont)) { \
  190.           *callbase=cleanup; *(callbase+1)=nil; \
  191.               module_mv_apply_1(callbase); \
  192.               call_continuation(callbase+1, \
  193.                 unwind_cont->CONTINUE.target, \
  194.                 unwind_cont->CONTINUE.value); \
  195.         } \
  196.             else { \
  197.               unwind_cont->CONTINUE.unwind = TRUE; 
  198.             
  199. #define END_U_P \
  200.         { LispObject tmp; \
  201.           tmp = *callbase; \
  202.           callbase += -2; \
  203.           cleanup = *callbase; \
  204.           unwind_cont =  *(callbase+1); \
  205.           *callbase = tmp;  \
  206.               unset_continue(unwind_cont); \
  207.           /* return value is TOS */ \
  208.           *(callbase+1)= cleanup; \
  209.           *(callbase+2)=nil; \
  210.               module_mv_apply_1(callbase+1); \
  211.           /* finally, return the returned value */ \
  212.         } \
  213.           } \
  214.       }
  215.  
  216. extern LispObject Integer,Pair,String,Real;
  217.  
  218. #define STATICINT(n,x) static struct integer_structure S/**/n = { TYPE_INT,-1,0,x}
  219. #define STATICCONS(n,x1,x2) static struct cons_structure S/**/n = {TYPE_CONS,-1,&Cons,&x1,&x2}
  220. #define STATICSTRING(n,s) static struct string_structure S/**/n = {TYPE_STRING,-1,&String,s}
  221. #define STATICFLOAT(n,x) static struct float_structure S/**/n = { TYPE_FLOAT,-1,&Real,x}
  222. #define STATICSYM(n) static LispObject S/**/n
  223. #define STATICVEC(n,vals) static struct cons_structure S/**/n **HELP**
  224. #define STATICCHAR(n,code) static struct character_structure S/**/n = { TYPE_CHAR,-1,&Character,0,(char) code }
  225.  
  226. /* extern LispFN3 Fn_cons;*/
  227. #define CONS_WITH_ARGS()  \
  228.   (topptr=callbase,PUSH(Fn_cons(callbase)))
  229.  
  230. #define UNKNOWN(a)
  231. #define STATIC(a) statics[a]
  232. #define LOCAL(mod,a) Module_/**/mod/**/.values[a]
  233. #define NONLOCAL(mod,a) Module_/**/mod/**/.values[a]
  234.  
  235. #define ENTRY
  236.  
  237. extern LispObject dp,dlp;
  238. extern void init_stack_frame(LispObject,int);
  239.  
  240. /* New definitions... */
  241.  
  242. #define VREF(v,i) vref((v),(i))
  243. #define LVREF_WITH_ARGS() (vref(*callbase,intval(*(callbase+1))))
  244.  
  245. #define CAR_WITH_ARGS() (CAR(*callbase))
  246. #define CDR_WITH_ARGS() (CDR(*callbase))
  247.  
  248. #define LAST_FRAME(v) (VREF(v,1))
  249. #define DISPLAYREF(d,i) (VREF(d,2+i))
  250. #define FRAME_TYPE(v) (VREF(v,0))
  251.  
  252. #define INLINE_ALLOC() dlp = dp
  253.  
  254. #define ALLOC(n) \
  255. { \
  256.   LispObject frame = allocate_vector(stacktop,localptr,n+2); \
  257.   init_stack_frame(frame,n); \
  258.   LAST_FRAME(frame) = dp; \
  259.   dlp = dp = frame; \
  260.   SAVE_DISPLAY; \
  261. }
  262.  
  263. #define DEALLOC \
  264.   dlp = dp = LAST_FRAME(dp);
  265.  
  266. extern LispObject allocate_e_function(LispObject *,LispObject,LispObject (*)(),int);
  267. extern LispObject allocate_e_macro(LispObject *,LispObject,LispObject (*)(),int);
  268. extern void transfer_display_to_heap(LispObject *callbase);
  269.  
  270. #define FUNCTION(mod,name,args) \
  271.   (allocate_e_function(stacktop,callbase, \
  272.               (LispObject) &Module_/**/mod, \
  273.               (LispObject (*)()) name, \
  274.               args))
  275.  
  276. #define MACRO(mod,name,args) \
  277.   (allocate_e_macro(stacktop,callbase, \
  278.             (LispObject) &Module_/**/mod, \
  279.             name, \
  280.             args))
  281.  
  282. extern LispObject module_mv_apply_1(LispObject *);
  283.  
  284. #define APPLY() ((*callbase)=(module_mv_apply_1(callbase)), topptr=callbase+1)
  285.  
  286. /* 
  287.  * Dynamics...
  288.  */
  289.  
  290. extern LispObject *dynamic_ref(LispObject);
  291. extern LispObject dynamic_setq(LispObject,LispObject);
  292.  
  293. #define make_dynamic(argptr,str,val) (get_symbol(argptr,str)->SYMBOL.gvalue = val)
  294.  
  295. #define DYNAMIC(name) (*dynamic_ref(statics[name]))
  296. #define DYNAMIC_SETQ(name,value) (dynamic_setq(name,value))
  297.  
  298. #define BIND(name,val) \
  299.           { \
  300.         struct envobject newenv; \
  301.         LispObject yow = (LispObject) &newenv; \
  302.         typeof(yow) = TYPE_ENV; \
  303.         gcof(yow) = -1; \
  304.         classof(yow) = Object; \
  305.         newenv.variable = statics[name]; \
  306.         newenv.value = val; \
  307.         newenv.next = DYNAMIC_ENV(); \
  308.         newenv.mutable = TRUE; \
  309.         *callbase=yow; \
  310.         callbase++; topptr = callbase+1; \
  311.         DYNAMIC_ENV() = (Env) &newenv; \
  312.  
  313. #define UNBIND() \
  314.         DYNAMIC_ENV() = DYNAMIC_ENV()->next; \
  315.         callbase += -1; \
  316.           }
  317.  
  318.  
  319. #else /* !!__stdc__ */
  320.  
  321. extern LispObject Slowcall(LispObject *);
  322. extern LispObject elvira_slowcall_object;
  323.  
  324. typedef LispObject (LispFN0)(LispObject *);
  325. typedef LispObject (LispFN1)(LispObject *);
  326. typedef LispObject (LispFN2)(LispObject *);
  327. typedef LispObject (LispFN3)(LispObject *);
  328. typedef LispObject (LispFN4)(LispObject *);
  329. typedef LispObject (LispFN5)(LispObject *);
  330. typedef LispObject (LispFN6)(LispObject *);
  331. typedef LispObject (LispFN7)(LispObject *);
  332. typedef LispObject (LispFN8)(LispObject *);
  333. typedef LispObject (LispFN)(LispObject *);
  334.  
  335. #define CALL(mod,offset,nargs,arglist)  \
  336.          { \
  337.             LispObject tmp = dp; \
  338.             STACK(tmp); \
  339.             dlp = dp = nil; \
  340.             o1 = \
  341.            ((*((LispFN##nargs *)Module_##mod.functions[offset])) == NULL ? \
  342.        elvira_slowcall_object = Module_##mod.values[offset], \
  343.        (LispFN##nargs *)Slowcall : \
  344.        (*((LispFN##nargs *)Module_##mod.functions[offset]))) arglist; \
  345.            UNSTACK(1); \
  346.            dlp = dp = tmp; \
  347.          }
  348.  
  349. #define LCALL(offset,nargs,arglist)   \
  350.          { \
  351.             LispObject tmp = dp; \
  352.             STACK(tmp); \
  353.             dlp = dp = nil; \
  354.             o1 = \
  355.               (functions[offset] == NULL ? \
  356.            elvira_slowcall_object = local_values[offset], \
  357.            (LispFN##nargs *)Slowcall : \
  358.            (*((LispFN##nargs *)functions[offset]))) arglist; \
  359.             UNSTACK(1); \
  360.             dlp = dp = tmp; \
  361.       }
  362.  
  363. #define FastLCALL(fn,nargs,arglist) \
  364.          { \
  365.             LispObject tmp = dp; \
  366.             STACK_TMP(tmp); \
  367.             dlp = dp = nil; \
  368.             o1 = (fn) arglist; \
  369.             UNSTACK_TMP(tmp); \
  370.             dlp = dp = tmp; \
  371.      }
  372.  
  373.  
  374. /* Not used these days */
  375. #define DCALL(dispref,nargs) (*((LispFN##nargs *)(dispref)))
  376. #define RCALL(reg,nargs) (*((LispFN##nargs *)reg))
  377.  
  378. /*
  379. #define CWCC(name) {  LispObject temp_cont = allocate_continue(),tdp;\
  380.                         tdp = dp; \
  381.             STACK(tdp); \
  382.             if (!set_continue(temp_cont)) {\
  383.               o1 = name(temp_cont);\
  384.               UNSTACK(1); \
  385.               dlp = dp = tdp; \
  386.                           unset_continue(temp_cont);\
  387.               }\
  388.             else {\
  389.               dlp = dp = tdp; \
  390.               UNSTACK(1); \
  391.               o1 = temp_cont->CONTINUE.value;\
  392.               }\
  393.            }
  394. */
  395.  
  396. #define BEGIN_W_CC() \
  397.          while (1) { \
  398.            LispObject temp_cont = allocate_continue(); \
  399.            STACK(temp_cont); \
  400.            transfer_display_to_heap(callbase); \
  401.        if (set_continue(temp_cont)) { \
  402.              o1 = temp_cont->CONTINUE.value; \
  403.              UNSTACK(1); \
  404.              break; \
  405.        } \
  406.            i1 = temp_cont;
  407.  
  408. #define END_W_CC() \
  409.            unset_continue(temp_cont); \
  410.            UNSTACK(1); \
  411.        break; \
  412.      }
  413.  
  414. #define BEGIN_W_H(reg) HANDLER_STACK() = Fn_cons(reg,HANDLER_STACK())
  415. #define END_W_H()      HANDLER_STACK() = CDR(HANDLER_STACK())
  416.  
  417. #define BEGIN_U_P(reg) \
  418.          { \
  419.         LispObject unwind_cont,cleanup;\
  420. \
  421.             cleanup = *callbase; \
  422.             unwind_cont = allocate_continue(callbase); \
  423.         *callbase = unwind_cont;\
  424.         *(callbase+1) = cleanup; \
  425.         callbase+=2;\
  426. \
  427.             if (set_continue(callbase,unwind_cont)) { \
  428.               module_mv_apply_1(cleanup,nil); \
  429.               call_continuation(callbase,unwind_cont->CONTINUE.target, \
  430.                 unwind_cont->CONTINUE.value); \
  431.         } \
  432.             else { \
  433.               unwind_cont->CONTINUE.unwind = TRUE; 
  434.             
  435. #define END_U_P \
  436.               unset_continue(callbase,unwind_cont); \
  437.               { \
  438.                 LispObject tmp = o1; \
  439.             LispObject stacktop = callbase;\
  440.                 STACK_TMP(tmp); \
  441.                 module_mv_apply_1(stacktop); \
  442.                 UNSTACK_TMP(tmp); \
  443.                 o1 = tmp; \
  444.           } \
  445.         } \
  446.      callbase += -2; \
  447.           }
  448.  
  449. extern LispObject Integer,Pair,String,Real;
  450.  
  451. #define STATICINT(n,x) static struct integer_structure S##n = { TYPE_INT,-1,0,x}
  452. #define STATICCONS(n,x1,x2) static struct cons_structure S##n = {TYPE_CONS,-1,&Cons,&x1,&x2}
  453. #define STATICSTRING(n,s) static struct string_structure S##n = {TYPE_STRING,-1,&String,s}
  454. #define STATICFLOAT(n,x) static struct float_structure S##n = { TYPE_FLOAT,-1,&Real,x}
  455. #define STATICSYM(n) static LispObject S##n
  456. #define STATICVEC(n,vals) static struct cons_structure S##n **HELP**
  457. #define STATICCHAR(n,code) static struct character_structure S##n = { TYPE_CHAR,-1,&Character,0,(char) code }
  458.  
  459. /* extern LispFN3 Fn_cons;*/
  460.  
  461. #define UNKNOWN(a)
  462. #define STATIC(a) statics[a]
  463. #define LOCAL(mod,a) Module_##mod##.values[a]
  464. #define NONLOCAL(mod,a) Module_##mod##.values[a]
  465. /*
  466. #define ENTRY LispObject dlp=dp
  467. */
  468. #define ENTRY
  469.  
  470. /*
  471. #define ALLOC(n) dp=dlp=frame(n,dlp)
  472. #define DEALLOC dp=dlp=dlp->dlp
  473. */
  474.  
  475. extern LispObject dp,dlp;
  476. extern void init_stack_frame(LispObject,int);
  477.  
  478. #define GCprotect(name) name=nil,STACK(name);
  479. #define GCpop(n) UNSTACK(n)
  480.  
  481. /* New definitions... */
  482.  
  483. #define VREF(v,i) vref(v,i)
  484. #define LVREF(v,i) vref(v,intval(i))
  485.  
  486. #define FRAME_TYPE(v) (VREF(v,0))
  487. #define LAST_FRAME(v) (VREF(v,1))
  488. #define DISPLAYREF(d,i) (VREF(d,2+i))
  489. #define ARG(d,i) DISPLAYREF(d,i)
  490.  
  491. #define FRAME(n) ALLOC(n)
  492. #define ALLOC(n) \
  493.          { \
  494.        char space[sizeof(struct vector_structure)+((n-1)+2)*sizeof(LispObject)]; \
  495.            LispObject frame = (LispObject) space; \
  496.        init_stack_frame(frame,n); \
  497.            LAST_FRAME(frame) = dp; \
  498.            dlp = dp = frame; \
  499.            STACK(frame);
  500.  
  501. #define DEALLOC \
  502.           UNSTACK(1); \
  503.           dlp = dp = LAST_FRAME(dp); }
  504.  
  505. extern LispObject allocate_e_function(LispObject *,LispObject,LispObject (*)(),int);
  506. extern LispObject allocate_e_macro(LispObject *,LispObject,LispObject (*)(),int);
  507. extern void transfer_display_to_heap(LispObject *);
  508.  
  509. #define FUNCTION(mod,name,args) \
  510.           allocate_e_function((LispObject) &Module_##mod,(LispObject (*)()) name,args)
  511.  
  512. #define MACRO(mod,name,args) \
  513.           allocate_e_macro((LispObject) &Module_##mod,name,args)
  514.  
  515. #define LINK_REG(reg) apply1(reg,i1)
  516.  
  517. /*
  518.           switch (typeof(reg)) { \
  519.        case TYPE_E_FUNCTION: \
  520.         { \
  521.           LispObject tmp = dp; \
  522.           STACK(tmp); \
  523.           dp = (LispObject) (reg->C_FUNCTION.env); \
  524.           o1 = (reg->C_FUNCTION.func) args; \
  525.           dp = tmp; \
  526.           UNSTACK(1); \
  527.           break; \
  528.         } \
  529.            default: \
  530.         CallError("LINK_REG: unknown operator thingy",reg,NONCONTINUABLE); \
  531.       }
  532.  
  533. */
  534.  
  535. extern LispObject module_mv_apply_1(LispObject,LispObject);
  536.  
  537. #define LINK_OBJ(reg) o1 = module_mv_apply_1(reg,i1)
  538.  
  539. #define APPLY(r1,r2) o1 = module_mv_apply_1(r1,r2)
  540.  
  541. /* 
  542.  * Dynamics...
  543.  */
  544.  
  545. extern LispObject *dynamic_ref(LispObject);
  546. extern LispObject dynamic_setq(LispObject,LispObject);
  547.  
  548. #define make_dynamic(str,val) (get_symbol(str)->SYMBOL.gvalue = val)
  549.  
  550. #define DYNAMIC(name) (*dynamic_ref(statics[name]))
  551. #define DYNAMIC_SETQ(name,value) (dynamic_setq(name,value))
  552.  
  553. #define BIND(name,val) \
  554.           { \
  555.         struct envobject newenv; \
  556.         LispObject yow = (LispObject) &newenv; \
  557.         newenv.type = TYPE_ENV; \
  558.         newenv.gc = -1; \
  559.         newenv.class = Object; \
  560.         newenv.variable = statics[name]; \
  561.         newenv.value = val; \
  562.         newenv.next = DYNAMIC_ENV(); \
  563.         newenv.mutable = TRUE; \
  564.         STACK(yow); \
  565.         DYNAMIC_ENV() = (Env) &newenv; 
  566.  
  567. #define UNBIND() \
  568.         DYNAMIC_ENV() = DYNAMIC_ENV()->next; \
  569.             UNSTACK(1); \
  570.           }
  571. #endif /* __STDC__*/
  572.